1 Preface

Load R packages and functions

library(tidyverse)
#> Warning: package 'tidyverse' was built under R version 4.2.1
#> ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
#> ✔ ggplot2 3.3.6      ✔ purrr   0.3.4 
#> ✔ tibble  3.1.8      ✔ dplyr   1.0.10
#> ✔ tidyr   1.2.1      ✔ stringr 1.4.1 
#> ✔ readr   2.1.2      ✔ forcats 0.5.2
#> Warning: package 'ggplot2' was built under R version 4.2.1
#> Warning: package 'tibble' was built under R version 4.2.1
#> Warning: package 'tidyr' was built under R version 4.2.1
#> Warning: package 'readr' was built under R version 4.2.1
#> Warning: package 'dplyr' was built under R version 4.2.1
#> Warning: package 'stringr' was built under R version 4.2.1
#> Warning: package 'forcats' was built under R version 4.2.1
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag()    masks stats::lag()
# install.packages("plyr")
library(plyr)
#> Warning: package 'plyr' was built under R version 4.2.1
#> ------------------------------------------------------------------------------
#> You have loaded plyr after dplyr - this is likely to cause problems.
#> If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
#> library(plyr); library(dplyr)
#> ------------------------------------------------------------------------------
#> 
#> Attaching package: 'plyr'
#> 
#> The following objects are masked from 'package:dplyr':
#> 
#>     arrange, count, desc, failwith, id, mutate, rename, summarise,
#>     summarize
#> 
#> The following object is masked from 'package:purrr':
#> 
#>     compact
# devtools::install_github("pavlakrotka/NCC@v1.0")
library(NCC)
#> Registered S3 methods overwritten by 'registry':
#>   method               from 
#>   print.registry_field proxy
#>   print.registry_entry proxy
#> Warning: package 'memoise' was built under R version 4.2.1
source("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/aux_functions.R")
set.seed(4678)

2 Case Study

We illustrate the optimal allocations in platform trials by means of a phase II placebo-controlled trial in primary hypercholesterolemia.

In the original study, patients were randomised to the three arms following 1:1:1. In what follows, we used this trial as a motivating study to describe how the patients would have been allocated to the different arms and periods using three allocation strategies -namely, equal allocation (1:…:1), square root of \(k\) (1:…:\(\sqrt(k)\)) and the proposed optimal allocations-, and according to three different trial designs:

  1. Design with one period only (that is, multi-arm design)
  2. Design with two periods (arm 2 starts later, but arms 1 and 2 finish at the same time)
  3. Design with three periods (arm 2 starts later and finishes after arm 1 does)

We also compare the power and type 1 error by means of simulations where we considered the estimated mean in the control arm in the original study. For comparative purposes, in this case study, we suppose total sample size of \(N=80\) and equal effect sizes for arms 1 and 2 as compared to control. Also, we considered a trial using concurrent controls only.

# means
mean_control = 17.3/3.5
mean_arm1 = 66.2/3.5
mean_arm2 = 72.3/3.5

2.1 Design 1: multi-arm design

In this case, we consider a design with one period only. The scheme of the trial over time is:

db1_one = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one",sl=0)
db1_sqrt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt",sl=0)
db1_opt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt",sl=0)
plot_trial(db1_one$data$treatment) 
Figure: Design 1: multi-arm design.

Figure: Design 1: multi-arm design.

# sample sizes
db1_one$ss
#>      [,1] [,2] [,3]
#> [1,]   31    0    0
#> [2,]   31    0    0
#> [3,]   31    0    0
db1_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]   27    0    0
#> [2,]   27    0    0
#> [3,]   38    0    0
db1_opt$ss
#>      [,1] [,2] [,3]
#> [1,]   27    0    0
#> [2,]   27    0    0
#> [3,]   38    0    0

db1_one_ss <- data.frame(arms=c("A1","A2","C"),db1_one$ss, c(sum(db1_one$ss[1,]),sum(db1_one$ss[2,]),sum(db1_one$ss[3,])))
db1_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db1_sqrt$ss, c(sum(db1_sqrt$ss[1,]),sum(db1_sqrt$ss[2,]),sum(db1_sqrt$ss[3,])))
db1_opt_ss <- data.frame(arms=c("A1","A2","C"), db1_opt$ss, c(sum(db1_opt$ss[1,]),sum(db1_opt$ss[2,]),sum(db1_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db1_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 31 0 0 31
A2 31 0 0 31
C 31 0 0 31
knitr::kable(db1_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 27 0 0 27
A2 27 0 0 27
C 38 0 0 38
knitr::kable(db1_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 27 0 0 27
A2 27 0 0 27
C 38 0 0 38

Comparing groups when using 1:1 allocation

res1_one = do.call(rbind.data.frame, models_cc(data = db1_one$data) )
res1_one$width_ci = res1_one$upper_ci  - res1_one$lower_ci  
knitr::kable(res1_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 14.07719 13.63552 14.51887 TRUE a1 0.8833584
0 15.99135 15.52805 16.45465 TRUE a2 0.9266013

Comparing groups when using \(\sqrt(k)\)-allocation (and thus optimal allocations)

res1_opt = do.call(rbind.data.frame, models_cc(data = db1_opt$data) )
res1_opt$width_ci = res1_opt$upper_ci  - res1_opt$lower_ci  
knitr::kable(res1_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.69845 13.15514 14.24175 TRUE a1 1.086613
0 15.62483 15.09305 16.15662 TRUE a2 1.063571

2.2 Design 2: two-period design

N = 92
N1 = round(N/4)
N2 = round(N-N1)
c(N1,N2,N-N1-N2)
#> [1] 23 69  0

In this case, we consider a design with two periods. The scheme of the trial over time is:

db2_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one",sl=0)
db2_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt",sl=0)
db2_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt",sl=0)
plot_trial(db2_one$data$treatment) 
Figure: Design 2: two-period design.

Figure: Design 2: two-period design.

# sample sizes
db2_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   23    0
#> [2,]   12   23    0
#> [3,]   12   23    0
db2_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   20    0
#> [2,]   12   20    0
#> [3,]   12   29    0
db2_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   27    0
#> [2,]   12   12    0
#> [3,]   12   30    0

db2_one_ss <- data.frame(arms=c("A1","A2","C"),db2_one$ss, c(sum(db2_one$ss[1,]),sum(db2_one$ss[2,]),sum(db2_one$ss[3,])))
db2_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db2_sqrt$ss, c(sum(db2_sqrt$ss[1,]),sum(db2_sqrt$ss[2,]),sum(db2_sqrt$ss[3,])))
db2_opt_ss <- data.frame(arms=c("A1","A2","C"), db2_opt$ss, c(sum(db2_opt$ss[1,]),sum(db2_opt$ss[2,]),sum(db2_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db2_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 23 0 23
A2 12 23 0 35
C 12 23 0 35
knitr::kable(db2_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 20 0 20
A2 12 20 0 32
C 12 29 0 41
knitr::kable(db2_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 27 0 27
A2 12 12 0 24
C 12 30 0 42

Comparing groups when using 1:1 allocation

res2_one = do.call(rbind.data.frame, models_cc(data = db2_one$data) )
res2_one$width_ci = res2_one$upper_ci  - res2_one$lower_ci  
knitr::kable(res2_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.93824 13.49230 14.38419 TRUE a1 0.8918892
0 15.27563 14.69288 15.85838 TRUE a2 1.1654993

Comparing groups when using \(\sqrt(k)\)-allocation

res2_sqrt = do.call(rbind.data.frame, models_cc(data = db2_sqrt$data) )
res2_sqrt$width_ci = res2_sqrt$upper_ci  - res2_sqrt$lower_ci  
knitr::kable(res2_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.81861 13.37003 14.26720 TRUE a1 0.8971737
0 15.82786 15.25850 16.39721 TRUE a2 1.1387031

Comparing groups when using the optimal allocations

res2_opt = do.call(rbind.data.frame, models_cc(data = db2_opt$data) )
res2_opt$width_ci = res2_opt$upper_ci  - res2_opt$lower_ci  
knitr::kable(res2_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.74539 13.21621 14.27456 TRUE a1 1.058350
0 15.51209 14.96092 16.06327 TRUE a2 1.102344

2.3 Design 3: three-period design

Suppose now a design with three periods with \(N_1=31\) and consider two situations for \(N_2\), say \(N_2=N-N_1\) and \(N_2= N_1/2\).

2.3.1 Trial with equal allocation rates for periods 1 and 3

Suppose now that the size of the periods are:

N1 = round(N/3)
N2 = round(N-2*N1)
c(N, N1, N2, N-N1-N2)
#> [1] 92 31 30 31

Note that in this case the duration of periods 1 and 3 is the same, leading to a symmetrical trial. Below we illustrate the scheme of the trial over time.


db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one",sl=0)
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt",sl=0)
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt",sl=0)

plot_trial(db3_opt$data$treatment) 
Design 3: three-period design (r1=r3).

Design 3: three-period design (r1=r3).


# sample sizes
db3_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   10   16
#> [2,]   16   10    0
#> [3,]   16   10   16
db3_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0    9   16
#> [2,]   16    9    0
#> [3,]   16   12   16
db3_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0    9   16
#> [2,]   16    9    0
#> [3,]   16   12   16

db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 10 16 26
A2 16 10 0 26
C 16 10 16 42
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 9 16 25
A2 16 9 0 25
C 16 12 16 44
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 9 16 25
A2 16 9 0 25
C 16 12 16 44

Comparing groups when using 1:1 allocation

res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
res3_one$width_ci = res3_one$upper_ci  - res3_one$lower_ci 
knitr::kable(res3_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.48048 12.88856 14.07240 TRUE a1 1.183837
0 15.28384 14.60315 15.96453 TRUE a2 1.361376

Comparing groups when using \(\sqrt(k)\)-allocation

res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
res3_sqrt$width_ci = res3_sqrt$upper_ci  - res3_sqrt$lower_ci 
knitr::kable(res3_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.95321 13.34558 14.56083 TRUE a1 1.215257
0 15.70560 15.15340 16.25780 TRUE a2 1.104402

Comparing groups when using the optimal allocations

res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
res3_opt$width_ci = res3_opt$upper_ci  - res3_opt$lower_ci 
knitr::kable(res3_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 14.22583 13.70043 14.75122 TRUE a1 1.050786
0 15.62031 15.08355 16.15706 TRUE a2 1.073516

2.3.2 Trial with unequal allocation rates for for periods 1 and 3

Suppose now that the size of the periods are:

# N = 92
N1 = round(N/3)
N2 = round(2*(N-N1)/3)
c(N1,N2,N-N1-N2) 
#> [1] 31 41 20
db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one",sl=0)
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt",sl=0)
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt",sl=0)

plot_trial(db3_opt$data$treatment) 
Design 3: three-period design (r1<r3).

Design 3: three-period design (r1<r3).


# sample sizes
db3_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   14   10
#> [2,]   16   14    0
#> [3,]   16   14   10
db3_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   12   10
#> [2,]   16   12    0
#> [3,]   16   17   10
db3_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   16   10
#> [2,]   16    8    0
#> [3,]   16   17   10

db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 14 10 24
A2 16 14 0 30
C 16 14 10 40
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 12 10 22
A2 16 12 0 28
C 16 17 10 43
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 16 10 26
A2 16 8 0 24
C 16 17 10 43

Comparing groups when using 1:1 allocation

res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
res3_one$width_ci = res3_one$upper_ci  - res3_one$lower_ci 
knitr::kable(res3_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.86849 13.35363 14.38334 TRUE a1 1.029711
0 16.27170 15.70384 16.83955 TRUE a2 1.135712

Comparing groups when using \(\sqrt(k)\)-allocation

res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
res3_sqrt$width_ci = res3_sqrt$upper_ci  - res3_sqrt$lower_ci 
knitr::kable(res3_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.65015 13.18111 14.11920 TRUE a1 0.9380894
0 15.72657 15.07479 16.37835 TRUE a2 1.3035579

Comparing groups when using the optimal allocations

res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
res3_opt$width_ci = res3_opt$upper_ci  - res3_opt$lower_ci 
knitr::kable(res3_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.82016 13.29698 14.34333 TRUE a1 1.046350
0 15.58663 15.00721 16.16606 TRUE a2 1.158848

3 Simulations

load("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/results/simstudy_results.RData")
df_res$design = ifelse(as.numeric(df_res$r1)+as.numeric(df_res$r2)==1,"2-period", "3-period")

To compare power and type 1 error of the different designs, we undertake a simulation study to evaluate the performance when using 1:1 allocations. For comparative purposes, we also consider a total sample size for the trial equal to XX

res_report_H1 <- df_res %>% filter(H0=="FALSE") %>% select(minrt,rt_a1,rt_a2,r1,r2,alloc,design)
knitr::kable(res_report_H1, format = "markdown", caption = c("Power comparisons"), col.names=c("Min Power", "Power A1", "Power A2", "r1",   "r2",   "Allocation",   "Design"))
Power comparisons
Min Power Power A1 Power A2 r1 r2 Allocation Design
0.90015 0.93188 0.90015 0.3375 0.4375 one 3-period
0.91773 0.91773 0.92704 0.3375 0.4375 opt 3-period
0.91739 0.94009 0.91739 0.3375 0.4375 sqrt 3-period
0.40323 0.71062 0.40323 0.25 0.75 one 2-period
0.48907 0.6354 0.48907 0.25 0.75 opt 2-period
0.40952 0.70559 0.40952 0.25 0.75 sqrt 2-period
res_report_H0 <- df_res %>% filter(H0=="TRUE") %>% select(minrt,rt_a1,rt_a2,r1,r2,alloc,design)
knitr::kable(res_report_H0, format = "markdown", caption = c("Type 1 error rate"), col.names=c("Min T1E", "T1E A1", "T1E A2",   "r1",   "r2",   "Allocation",   "Design"))
Type 1 error rate
Min T1E T1E A1 T1E A2 r1 r2 Allocation Design
0.0252 0.0252 0.02542 0.3375 0.4375 one 3-period
0.0245 0.02456 0.0245 0.3375 0.4375 opt 3-period
0.02396 0.02483 0.02396 0.3375 0.4375 sqrt 3-period
0.02464 0.02464 0.02515 0.25 0.75 one 2-period
0.02139 0.02139 0.02433 0.25 0.75 opt 2-period
0.02425 0.02425 0.02471 0.25 0.75 sqrt 2-period
 

Center for Medical Statistics, Informatics and Intelligent Systems, Medical University of Vienna.

[Klassifizierung: vertraulich]

Marta Bofill Roig

marta.bofillroig@meduniwien.ac.at

and Martin Posch

martin.posch@meduniwien.ac.at